home *** CD-ROM | disk | FTP | other *** search
- ;;; $Id: libguile.scm,v 1.3 1995/01/07 21:44:14 miles Exp $
- ;;; ----------------------------------------------------------------
- ;;; libguile.scm -- Basic guile interfaces
- ;;; 21 Dec 1994, Miles Bader <miles@eskimo.com>
- ;;; ----------------------------------------------------------------
- ;;;
-
- (in-package GUILE)
-
- (export-library GUILE
- (GUILE SCHEME R4RS MODULE VARIABLE GUILE-INTERNALS SLIB-HOOKS
- VICINITY RECORD TIME DEFMACRO SCM-ERRORS SCM-TIMERERS SCM))
- (export-library SCHEME
- (SCHEME SCM R4RS GUILE))
-
- ;; ----------------------------------------------------------------
- (in-module GUILE)
-
- ;; The standard guile definitions
- ;;
- (export-interface SCHEME
- (;; syntax
- quote quasiquote unquote unquote-splicing
- lambda and or if cond case define set! let let* letrec begin do
- ;; test
- not boolean? eq? eqv? equal?
- ;; lists
- pair? cons car cdr set-car! set-cdr!
- caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar
- caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar
- cdaddr cddaar cddadr cdddar cddddr
- null? list? list length append reverse list-ref memq memv member assq assv
- assoc
- ;; symbols
- symbol? symbol->string string->symbol
- ;; numbers
- number? complex? real? rational? integer? exact? inexact? = < > <= >= zero?
- positive? negative? odd? even? max min + * - / abs quotient remainder
- modulo gcd lcm numerator denominator floor ceiling truncate round
- rationalize exp log sin cos tan asin acos atan sqrt expt make-rectangular
- make-polar real-part imag-part magnitude angle exact->inexact
- inexact->exact number->string string->number
- ;; characters
- char? char=? char-ci=? char<? char-ci<? char>? char-ci>? char<=? char-ci<=?
- char>=? char-ci>=? char-alphabetic? char-numeric? char-whitespace?
- char-upper-case? char-lower-case? char->integer integer->char char-upcase
- char-downcase
- ;; strings
- string? make-string string string-length string-ref string-set! string=?
- string-ci=? string<? string-ci<? string>? string-ci>? string<=?
- string-ci<=? string>=? string-ci>=? substring string-append
- ;; vectors
- vector? make-vector vector vector-length vector-ref vector-set!
- ;; procs
- procedure? apply map for-each call-with-current-continuation
- ;; files
- call-with-input-file call-with-output-file input-port? output-port?
- current-input-port current-output-port open-input-file open-output-file
- close-input-port close-output-port eof-object? read read-char peek-char
- write display newline write-char
- ))
-
- (export-interface R4RS
- (list-tail string->list list->string string-copy string-fill! vector->list
- list->vector vector-fill! delay force with-input-from-file
- with-output-to-file char-ready? load transcript-on transcript-off
- define-syntax let-syntax letrec-syntax)
- ;; + base scheme
- SCHEME)
-
- (export-interface EXTRAS
- (output-port-width output-port-height current-error-port
- file-exists? delete-file force-output char-code-limit most-positive-fixnum
- identity gentemp 1+ -1+ 1-
- call-with-input-string call-with-output-string
- program-arguments getenv acons copy-tree
- eval dynamic-wind try-load append!
- software-type scheme-implementation-version scheme-implementation-type))
-
- (export-interface GUILE
- (define-macro delq!
- quit restart abort verbose gc room terms
- error system exec)
- EXTRAS
- R4RS)
-
- ;; ----------------------------------------------------------------
-
- ;; More tricky stuff...
- ;;
- (export-interface GUILE-INTERNALS
- (*top-level-lookup-thunk*
- *load-module* try-load-in-current-module))
-
- (export-interface VARIABLE
- (make-variable make-undefined-variable
- variable-ref variable-set! variable-bound?))
-
- ;; ----------------------------------------------------------------
-
- (export-interface SLIB-HOOKS
- (*features*
- slib:load-source slib:load slib:eval-load
- slib:exit slib:error slib:tab slib:form-feed slib:eval
- defmacro:load defmacro:eval
- tmpnam))
-
- (export-interface TIME
- (current-time difftime offset-time))
-
- (export-interface VICINITY
- (in-vicinity
- implementation-vicinity library-vicinity program-vicinity))
-
- (export-interface RECORD
- (make-record-type record-constructor record-predicate record-accessor
- record-modifier))
-
- (export-interface DEFMACRO
- (defmacro macroexpand macroexpand-1))
-
- ;; ----------------------------------------------------------------
- ;; Somewhat icky scm interfaces some of these are user-defined things;
- ;; unfortunately, the module systems means that the system won't see these if
- ;; (define ...) is used, so we need some other interface for them. there
- ;; needs to to be a real exception system anyway...
-
- (export-interface SCM-TIMERS
- (ticks alarm
- ticks-interrupt user-interrupt alarm-interrupt))
-
- (export-interface SCM-ERRORS
- (errno perror
- ;; The following are user-defined things; unfortunately, the module systems
- ;; means that the system won't see these if (define ...) is used, so we
- ;; need some other interface for them. there needs to to be a real
- ;; exception system anyway...
- out-of-storage could-not-open end-of-program hang-up arithmetic-error))
-
- (export-interface SCM
- (quit restart error errobj abort
- verbose gc room terms list-file system exec
- tmpnam *scm-version*)
- ;; + other stuff
- DEFMACRO
- VICINITY
- TIME
- RECORD
- SLIB-HOOKS
- SCM-ERRORS
- SCM-TIMERS
- EXTRAS
- R4RS)
-
- ;; ----------------------------------------------------------------
-
- (use-interface module) ; do more complex module operations
-
- ;; ----------------------------------------------------------------
- ;; More guile module support stuff
-
- ;; *LOAD-MODULE* -- exported
- ;;
- ;; This should be either a module, which will be current module when a file
- ;; is loaded, or a procedure which when called (with arguments ???) will
- ;; return a module to use.
- ;;
- (define *load-module*
- ;; start out with the `default/default' module.
- (find-module 'default
- (find-module 'default *root-package* make-package)
- make-user-module))
-
- (define try-load-in-current-module try-load)
- ;; Redefine try-load to bind the current module to *load-module* during loading
- ;; (try-load is called by load)
- (define (try-load file)
- (let ((old-module (current-module)))
- (dynamic-wind (lambda () (set-current-module *load-module*))
- (lambda () (try-load-in-current-module file))
- (lambda () (set-current-module old-module)))))
-